'233526 79
'GCV_FRONT = 2
'GCV_LEFT = 4
'GCV_RIGHT = 5
'GCV_EXTENDED = 7
'GCV_SIMPLIFIED = 8
'GCV_STANDARD = 9
'SIDE = GCV_FRONT

'DETAIL_LEVEL = GCV_EXTENDED

hatchAngle  = 45                  
'hatchStep= 2                   

'PAR_din=15
'PAR_D=28
'PAR_H=9
'PAR_din1=16
'PAR_D1=28
'PAR_r = 0.5
'PAR_twoRol=0

Dim math,iDA,iPoint
Const POINT_ARR = 2  
Const ko_MathPointParam = 14

''PAR_AXIS = 1
'++++
SUB LINE (x1,y1,x2,y2,t) Doc.ksLineSEG x1,y1,x2,y2,t END SUB
Sub ARC  (xc,yc,rad,x1,y1,x2,y2,Dir,style) doc.ksArcByPoint xc,yc,rad,x1,y1,x2,y2,Dir,style End Sub 
'++++

SUB Script_OnLoad ()

Set math = Kompas.GetMathematic2D
Set iDA = Kompas.GetDynamicArray(POINT_ARR)
Set iPoint = Kompas.GetParamStruct(ko_MathPointParam)

r = Par_R
DD = PAR_D
d = PAR_din
B = PAR_H/3
d1=PAR_din1
DD1=PAR_D1

Select Case DETAIL_LEVEL
       Case GCV_EXTENDED:
app r,DD,d,B,d1,DD1
Gost23526 r,DD,d,B,d1,DD1

       Case  GCV_STANDARD:
Gost23526ST r,DD,d,B,d1,DD1
       Case GCV_SIMPLIFIED:
Gost23526SIM r,DD,d,B,d1,DD1
End Select  

If PAR_AXIS = 1 Then 
  Line 0,-2,0,PAR_H+2,3
 End If 	

End Sub 
'+++
Sub Gost23526 (r,DD,d,B,d1,DD1)
 Ring r,DD,d1,B,1
 Ring r,DD,d1,B,-1

 Doc.ksMtr 0, 2*B,0, 1 ,1
 hatchAngle=hatchAngle -90
   Ring r,DD1,d,B,1
   Ring r,DD1,d,B,-1
 Doc.KsDeleteMtr 
 
 If (DD1-d)*0.5>(DD-d1)*0.5 Then 
 Lens= (DD-d1)*0.25
 xs =  (DD+d1)*0.25
 Else 
 Lens = (DD1-d)*0.25
  xs = (DD1+d)*0.25
 End If 
 rsh=b*0.5 
 If PAR_twoRol=0 Then 
 DrawRoller xs,B*1.5,rsh,Lens
 DrawRoller -xs,B*1.5,rsh,Lens
 Else 
 lens=lens*0.7
 DrawRoller xs-lens*0.5,B*1.5,rsh,Lens
 DrawRoller xs+lens*0.5,B*1.5,rsh,Lens
 DrawRoller -xs+lens*0.5,B*1.5,rsh,Lens
 DrawRoller -xs-lens*0.5,B*1.5,rsh,Lens
End If 
 End Sub 
'++++
 SUB DrawRoller ( xtr, ytr,  rads,Lens) 
  LEN1 =LENS* 0.5
  Line xtr-len1-2,ytr,xtr + len1+2,ytr,3
  Line  xtr - len1, ytr - rads, xtr - len1, ytr + rads, 1 
  Line  xtr - len1, ytr + rads, xtr + len1, ytr + rads, 1 
  Line  xtr + len1, ytr + rads, xtr + len1, ytr - rads, 1 
  Line  xtr + len1, ytr - rads, xtr - len1, ytr - rads, 1 
End Sub
'+++++
Sub Gost23526ST(r,DD,d,B,d1,DD1)
 Ring r,DD,d1,B,-1
 RingSim r,DD,d1,B,1
 Doc.ksMtr 0, 2*B,0, 1 ,1
 hatchAngle=hatchAngle -90
  RingSim r,DD1,d,B,1
  Ring r,DD1,d,B,-1
 Doc.KsDeleteMtr 
 
 If (DD1-d)*0.5>(DD-d1)*0.5 Then 
 Lens= (DD-d1)*0.25
 xs =  (DD+d1)*0.25
 Else 
 Lens = (DD1-d)*0.25
  xs = (DD1+d)*0.25
 End If 
 rsh=b*0.5 
 If PAR_twoRol=0 Then 

 DrawRoller -xs,B*1.5,rsh,Lens
 Else 
 lens=lens*0.7
 DrawRoller -xs+lens*0.5,B*1.5,rsh,Lens
 DrawRoller -xs-lens*0.5,B*1.5,rsh,Lens
End If 
 End Sub 
'++++
Sub Gost23526SIM(r,DD,d,B,d1,DD1)
 RingSim r,DD,d1,B,-1
 RingSim r,DD,d1,B,1
 Doc.ksMtr 0, 2*B,0, 1 ,1
 hatchAngle=hatchAngle -90
  RingSim r,DD1,d,B,1
  RingSim r,DD1,d,B,-1
 Doc.KsDeleteMtr 
End Sub  
'++++
Sub  Ring (r,DD,d,B,kx)
If PAR_AXIS = 1 Then 
Line 0,0,(DD*0.5-r)*kx,0,1
Else 
Line (d*0.5+r)*kx,0,(DD*0.5-r)*kx,0,1
End If 
arc (DD*0.5-r)*kx,r,r,(DD*0.5-r)*kx,0,DD*0.5*kx,r,kx,1
Line DD*0.5*kx,r,DD*0.5*kx,B-r,1
arc (DD*0.5-r)*kx,b-r,r,(DD*0.5-r)*kx,B,DD*0.5*kx,B-r,-kx,1
If PAR_AXIS = 1 Then
Line 0,B,(DD*0.5-r)*kx,B,1
Else
Line (d*0.5+r)*kx,B,(DD*0.5-r)*kx,B,1
End If 
If PAR_AXIS = 1 Then
Line 0,r,d*0.5*kx,r,1
Line 0,B-r,d*0.5*kx,B-r,1
End If 
Arc (d*0.5+r)*kx,r,r,(d*0.5+r)*kx,0,d*0.5*kx,r,-kx,1
Line d*0.5*kx,r,d*0.5*kx,B-r,1
Arc (d*0.5+r)*kx,B-r,r,d*0.5*kx,B-r,(d*0.5+r)*kx,B,-kx,1

Doc.kshatch  0, hatchAngle, hatchStep, 0, 0, 0   
Arc (d*0.5+r)*kx,r,r,(d*0.5+r)*kx,0,d*0.5*kx,r,-kx,1
Line d*0.5*kx,r,d*0.5*kx,B-r,1
Arc (d*0.5+r)*kx,B-r,r,d*0.5*kx,B-r,(d*0.5+r)*kx,B,-kx,1
Line (d*0.5+r)*kx,0,(DD*0.5-r)*kx,0,1
Line (d*0.5+r)*kx,B,(DD*0.5-r)*kx,B,1
arc (DD*0.5-r)*kx,r,r,(DD*0.5-r)*kx,0,DD*0.5*kx,r,kx,1
Line DD*0.5*kx,r,DD*0.5*kx,B-r,1
arc (DD*0.5-r)*kx,b-r,r,(DD*0.5-r)*kx,B,DD*0.5*kx,B-r,-kx,1
Doc.ksEndObj
End Sub 
'++++
Sub  RingSim (r,DD,d,B,kx)
If PAR_AXIS = 1 Then 
Line 0,0,(d*0.5+r)*kx,0,1
Line (d*0.5+r)*kx,0,(DD*0.5-r)*kx,0,1
Else 
Line (d*0.5+r)*kx,0,(DD*0.5-r)*kx,0,1
End If 
arc (DD*0.5-r)*kx,r,r,(DD*0.5-r)*kx,0,DD*0.5*kx,r,kx,1
Line DD*0.5*kx,r,DD*0.5*kx,B-r,1
arc (DD*0.5-r)*kx,b-r,r,(DD*0.5-r)*kx,B,DD*0.5*kx,B-r,-kx,1
If PAR_AXIS = 1 Then
Line 0,B,(DD*0.5-r)*kx,B,1
Else
Line (d*0.5+r)*kx,B,(DD*0.5-r)*kx,B,1
End If 
If PAR_AXIS = 1 Then
Line 0,r,d*0.5*kx,r,1
Line 0,B-r,d*0.5*kx,B-r,1
End If 
Arc (d*0.5+r)*kx,r,r,(d*0.5+r)*kx,0,d*0.5*kx,r,-kx,1
Line d*0.5*kx,r,d*0.5*kx,B-r,1
Arc (d*0.5+r)*kx,B-r,r,d*0.5*kx,B-r,(d*0.5+r)*kx,B,-kx,1
End Sub 

Sub App (r,DD,d,B,d1,DD1)
doc.ksColouring &HFE000000
Contur r,DD,d1,B,1
Contur r,DD,d1,B,-1
Doc.ksMtr 0, 2*B,0, 1 ,1
Contur r,DD1,d,B,1
Contur r,DD1,d,B,-1
Doc.KsDeleteMtr 

If (DD1-d)*0.5>(DD-d1)*0.5 Then 
 Lens= (DD-d1)*0.25
 xs =  (DD+d1)*0.25
 Else 
 Lens = (DD1-d)*0.25
  xs = (DD1+d)*0.25
 End If 
 rsh=b*0.5 
 If PAR_twoRol=0 Then 
  Line  -xs - lens*0.5, B*1.5 - rsh, -xs - lens*0.5, B*1.5 + rsh, 1
  Line  xs+lens*0.5, B*1.5 + rsh, xs+lens*0.5, B*1.5 - rsh, 1 
  Line -xs - lens*0.5, B*1.5 - rsh, xs + lens*0.5, B*1.5 - rsh, 1
  Line -xs - lens*0.5, B*1.5 + rsh, xs + lens*0.5, B*1.5 + rsh, 1
Else 
 lens=lens*0.7
  Line  -xs -lens, B*1.5 - rsh, -xs - lens, B*1.5 + rsh, 1
  Line  xs + lens, B*1.5 + rsh, xs + lens, B*1.5 - rsh, 1
  Line  -xs -lens, B*1.5 - rsh, xs + lens, B*1.5 - rsh, 1
  Line  -xs -lens, B*1.5 + rsh, xs + lens, B*1.5 + rsh, 1
End If 
doc.ksEndObj
End Sub 
'++++
Sub Contur (r,DD,d,B,kx)
Line 0,0,(DD*0.5-r)*kx,0,1
arc (DD*0.5-r)*kx,r,r,(DD*0.5-r)*kx,0,DD*0.5*kx,r,kx,1
Line DD*0.5*kx,r,DD*0.5*kx,B-r,1
arc (DD*0.5-r)*kx,b-r,r,(DD*0.5-r)*kx,B,DD*0.5*kx,B-r,-kx,1
Line 0,B,(DD*0.5-r)*kx,B,1
End Sub 